In ahorawzy/TFTSA: Traffic Flow Time Series Analysis

library(ggplot2)
library(TFTSA)

1. 读取数据

tmlzzloess <- read.csv("D://data//thesis//201610//tmlzzloess.csv",header = T)
tmlzznew <- read.csv("D://data//thesis//201610//tmlzznew.csv",header = T)

rownames(tmlzzloess) <- tmlzzloess[,1]
tmlzzloess <- tmlzzloess[,-1]
rownames(tmlzznew) <- tmlzznew[,1]
tmlzznew <- tmlzznew[,-1]

2. 设定object flow和flow database

2.1 将flow database设为原始数据

tmlobj <- tmlzznew[6,]
tmlbase <- tmlzznew[-6,]

pre1006 <- TFTSA::flow_knn(tmlobj,tmlbase,start = 73,k = 3,lag_duration = 24,fore_duration = 12)

(forecast_raw <- flow_forecastplot(tmlobj,pre1006))

flow_evaluate(tmlobj,pre1006)

2.2 将flow database设为LOESS后的数据

tmlobj <- tmlzznew[6,]
tmlbase <- tmlzzloess[-6,]

pre1006 <- TFTSA::flow_knn(tmlobj,tmlbase,start = 73,k = 3,lag_duration = 24,fore_duration = 12)

flow_forecastplot(tmlobj,pre1006)

flow_evaluate(tmlobj,pre1006)

2.3 非对称预测

pre_imbalance <- flow_knn(obj = tmlobj,base = tmlbase,start = 73,k = 3,lag_duration = 24,fore_duration = 12,imbalance=T)

flow_forecastplot(tmlobj,pre_imbalance)

flow_evaluate(tmlobj,pre_imbalance)

preall <- rbind(tmlobj,pre1006,pre_imbalance)
preall <- t(preall)
preall <- as.data.frame(preall)
names(preall) <- c("real","balance","imbalance")

ggplot(preall,aes(1:288,preall$real))+geom_point(colour="steelblue")+geom_line(colour="steelblue")+
  geom_line(aes(1:288,preall$balance),colour="orange",size=1)+
  geom_line(aes(1:288,preall$imbalance),colour="red",size=1)+
  xlab("Timestamp")+ylab("Traffic flow rate")+
  scale_x_continuous(breaks = seq(0,288,24))+
  scale_y_continuous(breaks = seq(0,120,20))

3. 非对称预测的鲁棒性分析

3.1 关于K灵敏度的鲁棒性分析

opti_k <- function(from,to){
  result <- data.frame(matrix(NA,10,4))
  for(i in 2:10){
    pre_k <- flow_knn(tmlobj,tmlbase,start = 73,k = i,lag_duration = 24,fore_duration = 12)
    result[i,1:4] <- flow_evaluate(tmlobj,pre_k)
  }
  result <- na.omit(result)
  names(result) <- c("mse","rmse","mae","imse")
  return(result)
}

optik <- opti_k()
optik

write.csv(optik,"D:\\交大云同步\\论文\\小论文\\4_基于KNN方法的短时交通流序列非对称损失预测\\实验结果\\optik.csv")

opti_k_im <- function(from,to){
  result <- data.frame(matrix(NA,10,4))
  for(i in 2:10){
    pre_k <- flow_knn(tmlobj,tmlbase,start = 73,k = i,lag_duration = 24,fore_duration = 12,imbalance = T)
    result[i,1:4] <- flow_evaluate(tmlobj,pre_k)
  }
  result <- na.omit(result)
  names(result) <- c("mse","rmse","mae","imse")
  return(result)
}
optik_im <- opti_k_im()
optik_im

write.csv(optik_im,"D:\\交大云同步\\论文\\小论文\\4_基于KNN方法的短时交通流序列非对称损失预测\\实验结果\\optik_im.csv")

3.2 关于lag_duration的鲁棒性检验

opti_ld <- function(from,to){
  result <- data.frame(matrix(NA,10,4))
  for(i in seq(from,to,2)){
    pre_k <- flow_knn(tmlobj,tmlbase,start = 73,k = 3,lag_duration = i,fore_duration = 12)
    result[i,1:4] <- flow_evaluate(tmlobj,pre_k)
  }
  result <- na.omit(result)
  names(result) <- c("mse","rmse","mae","imse")
  return(result)
}

optild <- opti_ld(4,48)
optild

write.csv(optild,"D:\\交大云同步\\论文\\小论文\\4_基于KNN方法的短时交通流序列非对称损失预测\\实验结果\\optild.csv")

opti_ld_im <- function(from,to){
  result <- data.frame(matrix(NA,10,4))
  for(i in seq(from,to,2)){
    pre_k <- flow_knn(tmlobj,tmlbase,start = 73,k = 5,lag_duration = i,fore_duration = 12,imbalance = T)
    result[i,1:4] <- flow_evaluate(tmlobj,pre_k)
  }
  result <- na.omit(result)
  names(result) <- c("mse","rmse","mae","imse")
  return(result)
}

optild_im <- opti_ld_im(4,48)
optild_im

write.csv(optild_im,"D:\\交大云同步\\论文\\小论文\\4_基于KNN方法的短时交通流序列非对称损失预测\\实验结果\\optild_im.csv")

3.3 关于forecasting_duration的鲁棒性检验

opti_fd <- function(from,to){
  result <- data.frame(matrix(NA,20,4))
  for(i in seq(from,to,2)){
    try({
      pre_fd <- flow_knn(tmlobj,tmlbase,start = 73,k = 3,lag_duration = 24,fore_duration = i)
      result[i,1:4] <- flow_evaluate(tmlobj,pre_fd)
    })
  }
  result <- na.omit(result)
  names(result) <- c("mse","rmse","mae","imse")
  return(result)
}

optifd <- opti_fd(2,48)
optifd

write.csv(optifd,"D:\\交大云同步\\论文\\小论文\\4_基于KNN方法的短时交通流序列非对称损失预测\\实验结果\\optifd.csv")

opti_fd_im <- function(from,to){
  result <- data.frame(matrix(NA,20,4))
  for(i in seq(from,to,2)){
    try({
      pre_fd <- flow_knn(tmlobj,tmlbase,start = 73,k = 5,lag_duration = 30,fore_duration = i,imbalance = T)
      result[i,1:4] <- flow_evaluate(tmlobj,pre_fd)
    })
  }
  result <- na.omit(result)
  names(result) <- c("mse","rmse","mae","imse")
  return(result)
}

optifd_im <- opti_fd_im(2,48)
optifd_im

write.csv(optifd_im,"D:\\交大云同步\\论文\\小论文\\4_基于KNN方法的短时交通流序列非对称损失预测\\实验结果\\optifd_im.csv")

3.4 最佳参数选择

opt_best <- flow_knn(tmlobj,tmlbase,start = 73,k=5,lag_duration = 30, fore_duration = 12, imbalance = T)
flow_evaluate(tmlobj,opt_best)

preall <- rbind(tmlobj,pre1006,opt_best)
preall <- t(preall)
preall <- as.data.frame(preall)
names(preall) <- c("real","balance","imbalance")

ggplot(preall,aes(1:288,preall$real))+geom_point(colour="steelblue")+geom_line(colour="steelblue")+
  geom_line(aes(1:288,preall$balance),colour="orange",size=1)+
  geom_line(aes(1:288,preall$imbalance),colour="red",size=1)+
  xlab("Timestamp")+ylab("Traffic flow rate")+
  scale_x_continuous(breaks = seq(0,288,24))+
  scale_y_continuous(breaks = seq(0,120,20))+
  theme_bw()

ggsave(file="D:\\交大云同步\\论文\\小论文\\4_基于KNN方法的短时交通流序列非对称损失预测\\绘图\\对称非对称对比图2.jpg",width=7.29,height=4.5,dpi=600)

ahorawzy/TFTSA documentation built on May 13, 2019, 12:18 p.m.